(import
 (except (rnrs base)
         let-values
         map
         error
         vector-map)
 (only (guile)
       lambda* λ
       simple-format
       current-output-port)
 (fileio)
 (ice-9 pretty-print)
 (ice-9 peg)
 (ice-9 match)
 (prefix (peg-tree-utils) peg-tree:)
 ;; (ice-9 format)
 (srfi srfi-1)
 (pipeline)
 (debug)
 ;; receive
 (srfi srfi-8)
 (srfi srfi-9 gnu)
 ;; hash tables
 (srfi srfi-69)
 ;; let-values
 (srfi srfi-11)
 (graph-algorithm)
 ;; functional sets
 (pfds sets))


(define input-filename "graphs/example-graph-for-a-star.txt")


(define-peg-pattern NUMBER body (and (? (or "-" "+")) (+ (range #\0 #\9))))
(define-peg-pattern SPACE none " ")
(define-peg-pattern COMMA none ",")
(define-peg-pattern ARROW none "->")
(define-peg-pattern ANYTHING-EXCEPT-SPACE body
  (* (and (not-followed-by SPACE) peg-any)))

(define-peg-pattern Y all NUMBER)
(define-peg-pattern X all NUMBER)
(define-peg-pattern COORDS all (and Y COMMA X))
(define-peg-pattern NODE all (and NODE-NAME SPACE COORDS))

(define-peg-pattern NODE-NAME all (+ ANYTHING-EXCEPT-SPACE))
(define-peg-pattern SOURCE-NODE all NODE-NAME)
(define-peg-pattern TARGET-NODE all NODE-NAME)
(define-peg-pattern WEIGHT all NUMBER)

(define-peg-pattern ASSOCIATION all
  (and SOURCE-NODE SPACE
       ARROW SPACE
       TARGET-NODE SPACE
       WEIGHT))


(define-immutable-record-type <node>
  (make-node name y x neighbors)
  node?
  (name node-name set-node-name)
  (y node-y set-node-y)
  (x node-x set-node-x)
  (neighbors node-neighbors set-node-neighbors))


;; FUNCTIONAL SET HELPERS
(define make-empty-set
  (λ (less?)
    (make-set less?)))


(define set-insert-multiple
  (λ (myset items)
    (cond
     [(null? items) myset]
     [else
      (set-insert-multiple (set-insert myset (car items))
                           (cdr items))])))


(define set-empty?
  (λ (set)
    (= (set-size set) 0)))


(define node<
  (λ (n1 n2)
    (or (< (node-y n1) (< node-y n2))
        (and (= (node-y n1) (< node-y n2))
             (< (node-x n1) (< node-x n2))))))


(define identity (λ (any) any))


(define association-parse-trees->associations
  (λ (association-parse-trees)
    (let iter
        ([trees° association-parse-trees]
         [previous-node-name°
          (car (peg-tree:tree-refs (first association-parse-trees) '(SOURCE-NODE NODE-NAME)))]
         [neighbors° '()]
         [nodes-to-neighbors° '()])
      (cond
       [(null? trees°)
        (alist->hash-table
         (cons (cons previous-node-name° neighbors°)
               nodes-to-neighbors°))]
       [else
        (let* ([tree (first trees°)]
               [node-name (car (peg-tree:tree-refs tree '(SOURCE-NODE NODE-NAME)))]
               [neighbor-name (car (peg-tree:tree-refs tree '(TARGET-NODE NODE-NAME)))])
          (cond
           [(string=? previous-node-name° node-name)
            (iter (drop trees° 1)
                  previous-node-name°
                  (cons neighbor-name neighbors°)
                  nodes-to-neighbors°)]
           [else
            (iter (drop trees° 1)
                  node-name
                  (list neighbor-name)
                  (cons (cons previous-node-name° neighbors°)
                        nodes-to-neighbors°))]))]))))


(define node-parse-tree->associations
  (λ (tree)
    (make-node (car (peg-tree:tree-refs tree '(NODE NODE-NAME)))
               (string->number (car (peg-tree:tree-refs tree '(NODE COORDS Y))))
               (string->number (car (peg-tree:tree-refs tree '(NODE COORDS X))))
               '())))


;; PARSE
(define parse-associations
  (λ (line)
    (-> line
        (match-pattern ASSOCIATION)
        peg:tree)))


(define parse-nodes
  (λ (line)
    (-> line
        (match-pattern NODE)
        peg:tree)))


(define lines (get-lines-from-file input-filename))


(define associations
  (-> lines
      (map parse-associations)
      (filter identity)
      association-parse-trees->associations))


(define nodes
  (-> lines
      (map parse-nodes)
      (filter identity)
      (map node-parse-tree->associations)
      (map (λ (node)
             (set-node-neighbors node (hash-table-ref associations (node-name node))))
           #|arg|#)))


(pretty-print nodes)

;; (pretty-print associations)
;; (pretty-print (hash-table-keys associations))
;; (pretty-print (hash-table-values associations))


;; (define nodes
;;   (λ (associations)
;;     (let iter ([node-neighbor-names (make-empty-set node<)])
;;       )))
